perm filename MAKNUM.F4[P11,LCS]1 blob sn#570607 filedate 1981-03-09 generic text, type T, neo UTF8
	 SUBROUTINE MAKNUM(RNUM)
       COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	1 /STF/RSTFAC(8),RSTJ2
CC	1 /NFONT/NFONT
C*** PUT THIS IN AFTER ALPHA IS TRANSLATED
      EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
     1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
     1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
     1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
      DATA RS/10.0/,RBX/1.0/
      RB8=R8
      J3X=J3
C P7=0=BDR40; =1=BDI40; =2=PRIM.
	IF(R6.GE.100.)R6=R6-100.
	IF(R6.EQ.0)R6=1.
	R5=R6
C IF R6 > 100 IT'S FOR THE PAGE PROG.  SUBTRACT 100 TO GET TRUE SIZE
C  IF IT'S 0 MAKE INTO 1.0   UPPER CASE - BDR40
	IF(R7.GT.2.)R7=0
      R6=48000000.0+(R7+50.)*10000.
      R7=99999999.0
C  BLANKS
	ONE=0
      IF(RNUM.NE.9999.)GO TO 2
C  NEXT FOR 'C'OMMON TIME
      RNUM=12.
C  MAKES A 'C'
      R4=R4-2.2
C  .2 FOR BAD POS. OF LETTERS
	GO TO 4
2     RNUM=IFIX(RNUM)
C  SO MISTAKES (I.E. 2.2) WON'T BREAK THE PROG.
      IF(RNUM.EQ.1.)ONE=3.
      IF(RNUM.GT.9.)GO TO 3
C  JUMP FOR 2 OR 3 DIGIT NUMBER
4     R6=R6+RNUM*100.+47.
C  PUTS BLANK ON END (.47)
	GO TO 1
3     RJY=10.
      IF(RNUM.GE.100.)RJY=100.
      B=IFIX(RNUM/RJY)
      C=AMOD(RNUM,RJY)
      IF(RNUM.LT.100)GO TO 7
      D=IFIX(C/10.)
      C=AMOD(C,10.)
      IF(C.EQ.1.)ONE=ONE+3.
      R7=C*1000000.+999999.0
	C=D
7     R6=R6+B*100.+C
      IF(B.EQ.1.)ONE=ONE+3.
      IF(C.EQ.1.)ONE=ONE+3.
      B=R5
      IF(RNUM.GE.100.)B=B*2
      J3=J3-RS*RSTJ2*B
C  FOR 2 DIGIT NUMBER   ADJUSTS FOR 11, ETC.
1     J3=J3+ONE*R5*RSTJ2
C CENTERS THE NUMBER '1'
	MFONT=NFONT
      CALL ALPHA
	NFONT=MFONT
C RESTORE FONT TO WHATEVER IT WAS BEFORE
      J3=J3X
      IF(RB8.EQ.0)RETURN
C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
	R3=J3-R5
      IF(J10.EQ.0)J10=1
C USE J10 FOR EVEN THICKER BOX AND CIRC.
      IF(RNUM.GT.9)R3=R3+R5*RBX
C  TO SET CENTER
      IF(RB8.EQ.2.)GO TO 5
      R4=R4+R5+.1+.05/R5
C  END OF ABOVE IS FOR SMALL CIRCLES.
      B=4.5
      IF(RNUM.GE.100.)B=5.5
      R5=R5*B
	J6=0
	J7=0
	J8=J10
	CALL CENTX
	CALL CIRCLE
	RETURN
5	B=6.
	R9=0
      IF(RNUM.LT.100.)GO TO 8
      B=9.
      R9=R5*6.
C  MAKES RECTANGLE IF >=100
8     R4=R4+R5*.7+.1
      R8=R5*B
      J5=50
	 R3=R3+1.0
C   SHIFT BOX SLIGHTLY TO RIGHT
	CALL ITMSUB
	END